home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Windows Game Programming for Dummies (2nd Edition)
/
WinGamProgFD.iso
/
mac
/
DirectX SDK
/
DXSDK
/
samples
/
Multimedia
/
VBSamples
/
Direct3D
/
AutoParts
/
data.cls
< prev
next >
Wrap
Text File
|
2001-10-08
|
4KB
|
177 lines
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "Data"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved.
'
' File: data.cls
' Content: DATA MIDDLEWARE
' replace with your favorite
' database code
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Type rec
AssemblyId As Long
ModelPart As String
PartID As String
Description As String
Price As Currency
CompatibleParts As String
Stock As String
PartMake As String
End Type
Dim rs() As rec
Dim index As Integer
Dim lastindex As Integer
Dim maxsize As Integer
Public Function MoveTop()
index = 0
MoveTop = True
End Function
Public Function IsEOF()
If index = -1 Then IsEOF = True
End Function
Public Function MoveNext()
If index = lastindex Then
index = -1
Exit Function
End If
index = index + 1
MoveNext = True
End Function
Public Property Get ModelPart() As String
ModelPart = rs(index).ModelPart
End Property
Public Property Get PartID() As String
PartID = rs(index).PartID
End Property
Public Property Get Description() As String
Description = rs(index).Description
End Property
Public Property Get Price() As Currency
Price = rs(index).Price
End Property
Public Property Get CompatibleParts() As String
CompatibleParts = rs(index).CompatibleParts
End Property
Public Property Get Stock() As String
Stock = rs(index).Stock
End Property
Public Property Get PartMake() As String
PartMake = rs(index).PartMake
End Property
Public Function MoveToModelPartRecord(sname As String) As Boolean
For index = 0 To lastindex
If (UCase(rs(index).ModelPart) = UCase(sname)) Then
MoveToModelPartRecord = True
Exit Function
End If
Next
MoveToModelPartRecord = False
End Function
Function InitData(sFile As String) As Boolean
Dim strData As String
On Local Error GoTo errOut
ReDim rs(100)
maxsize = 100
Dim fl As Long
fl = FreeFile
index = 0
Open sFile For Input As #fl
Line Input #fl, strData
Do While Not EOF(fl)
Line Input #fl, strData
Dim j As Long, q As Long
Dim r As rec
'Assembly ID - what assembly does this belong to
j = 1
q = InStr(j, strData, Chr(9))
r.AssemblyId = Mid$(strData, 1, q - 1)
'Unique ID for all parts
j = q + 1
q = InStr(j, strData, Chr(9))
r.PartID = Mid$(strData, j, q - j)
'Model Part .. whats the name of the part in the xfile
j = q + 1
q = InStr(j, strData, Chr(9))
r.ModelPart = Mid$(strData, j + 1, q - 2 - j)
'Part Price
j = q + 1
q = InStr(j, strData, Chr(9))
r.Price =val(Mid$(strData, j + 1, q - 1 - j))
'Description
j = q + 1
q = InStr(j, strData, Chr(9))
r.Description = Mid$(strData, j + 1, q - 2 - j)
'Stock
j = q + 1
q = InStr(j, strData, Chr(9))
r.Stock = Mid$(strData, j, q - j)
'PartMake
j = q + 1
q = InStr(j, strData, Chr(9))
r.PartMake = Mid$(strData, j + 1, q - j - 2)
'CompatibleParts
j = q + 1
r.CompatibleParts = Mid$(strData, j + 1)
q = Len(r.CompatibleParts) - 1
r.CompatibleParts = Mid$(r.CompatibleParts, 1, q)
If index > maxsize Then
maxsize = maxsize + 100
ReDim Preserve rs(maxsize)
End If
rs(index) = r
lastindex = index
index = index + 1
Loop
InitData = True
Exit Function
errOut:
InitData = False
End Function